{-# LANGUAGE ScopedTypeVariables,BangPatterns #-}

import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.ST
import Control.Monad

import Statistics.RandomVariate as RV

import System.IO
import System.Win32

import Data.Array.Vector
import Data.Word

main :: IO ()
main = do hSetBuffering stdout NoBuffering
          hSetBuffering stdin NoBuffering
          res <- testPar someNumbers
          putStrLn (show res)

someNumbers = [123,456,789,012,345,678,910,234,567,890]

modifyTVar :: TVar a -> (a -> a) -> STM () 
modifyTVar tv f = readTVar tv >>= writeTVar tv . f

runPar1 :: [IO a] -> IO [a]
runPar1 jobs
  = do putStrLn "Using runPar1 ..."
       resVar <- newTVarIO []
       mapM_ (forkIO . (runjob resVar)) jobs
       atomically $ do res <- readTVar resVar
                       when (length res < length jobs) retry
                       return res
  where runjob tv job = do (!jobresult) <- job
                           putStr "" -- no-op
                           atomically $ do rs <- readTVar tv
                                           writeTVar tv (jobresult : rs)

runPar2 :: [IO a] -> IO [a]
runPar2 jobs
  = do putStrLn "Using runPar2 ..."
       resVar <- newTVarIO []
       mapM_ (forkIO . (runjob resVar)) jobs
       atomically $ do res <- readTVar resVar
                       when (length res < length jobs) retry
                       return res
  where runjob tv job = do jobresult <- job
                           atomically $ do rs <- readTVar tv
                                           writeTVar tv (jobresult : rs)


runPar3 :: [IO Int] -> IO [Int]
runPar3 ps 
    = do mapM_ (forkIO.runres) ps
         putStrLn "Forked"
         sleep 20000
         return []
    where runres :: IO Int -> IO ()
          runres x = do y <- x
                        putStrLn (show y)

vlots = 1000000000 :: Int

testPar1 :: [Word32] -> IO [Int] -- Uses 1 core with -RTS +N4
testPar1 s = runPar1 (map repeator s)
    where repeator :: Word32 -> IO Int
          repeator k = return (head (drop vlots (repeat $ fromIntegral k)))

testPar2 :: [Word32] -> IO [Int] -- Uses 1 core with -RTS +N4
testPar2 s = runPar2 (map repeator s)
    where repeator :: Word32 -> IO Int
          repeator k = return (head (drop vlots (repeat $ fromIntegral k)))


testPar3 :: [Word32] -> IO [Int]  -- Uses 4 cores wth -RTS +N4
testPar3 s = runPar2 [repeator 123, repeator 456, repeator 789, repeator 101112]
    where repeator :: Word32 -> IO Int
          repeator k = return (head (drop vlots (repeat $ fromIntegral k)))

lots = 10000000 :: Int

testPar :: [Word32] -> IO [Int]
testPar s = runPar2 (map simrand s)
    where simrand :: Word32 -> IO Int
          --simrand k = let x = (runST (simrand1 k)) in (putStrLn (show x) >> return x)
          simrand k = let x = (runST (simrand1 k)) in (return x) 
          simrand1 k = RV.initialize (singletonU k) >>= \g -> getRNum g lots
          getRNum :: Gen a -> Int -> ST a Int
          getRNum g 0 = RV.uniform g
          getRNum g i = RV.uniform g >>= \ (x::Int) -> getRNum g (i-1) 